CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/swagn_r.zip/POINTERS.SWG/0018_Example of LINKED Records.pas

Pascal/Delphi Source File | 1994-08-24 | 5KB | 239 lines

program LinkLst2;

uses
  Crt;

const
  FileName = 'LinkExp.dta';

type
  PMyNode = ^TMyNode;
  TMyNode = record
    Name  : String;
    Flight: integer;
    Day   : String;
    Next  : PMyNode;  {Used to link each field}
  end;

procedure CreateNew(var Item: PMyNode);
begin
  New(Item);
  Item^.Next := nil;
  Item^.Name := '';
  Item^.Flight := 0;
  Item^.Day := '';
end;

procedure GetData(var Item: PMyNode);
begin
  ClrScr;
  repeat
    GotoXY(1, 1);
    Write('Enter Name: ');
    Read(Item^.Name);
  until (Item^.Name <> '');
  GotoXY(1, 2);
  Write('Enter Flight number: ');
  ReadLn(Item^.Flight);
  GotoXY(1, 3);
  Write('Enter Day: ');
  ReadLn(Item^.Day);
end;

procedure DoFirst(var First, Current: PMyNode);
begin
  CreateNew(Current);
  GetData(Current);
  First := Current;
end;

procedure Add(var Prev, Current: PMyNode);
begin
  Prev := Current;
  CreateNew(Current);
  GetData(Current);
  Prev^.Next := Current;
end;

procedure DeleteNode(var Head, Node, Current: PMyNode);
var
  Temp: PMyNode;
begin
  Temp := Head;
  while Temp^.Next <> Node do
    Temp := Temp^.Next;
  if Temp^.Next^.Next <> nil then
    Temp^.Next := Temp^.Next^.Next
  else begin
    Temp^.Next := nil;
    Current := Temp;
  end;
  Dispose(Node);
end;

function Find(Head: PMyNode; S: String): PMyNode;
var
  Temp: PMyNode;
begin
  Temp := nil;
  while Head^.Next <> nil do begin
    if Head^.Name = S then begin
      Temp := Head;
      break;
    end;
    Head := Head^.Next;
  end;
  if Head^.Name = S then Temp := Head;
  Find := Temp;
end;

procedure DoDelete(var Head, Current: PMyNode);
var
  S: String;
  Temp: PMyNode;
begin
  ClrScr;
  Write('Enter name from record to delete: ');
  ReadLn(S);
  Temp := Find(Head, S);
  if Temp <> nil then
    DeleteNode(Head, Temp, Current);
end;

procedure ShowRec(Item: PMyNode; i: Integer);
begin
  GotoXY(1, i); Write('Name: ', Item^.Name);
  GotoXY(25, i); Write('Flight: ', Item^.Flight);
  GotoXY(45, i); Write('Day: ', Item^.Day);
end;

procedure Show(Head: PMyNode);
var
  i: Integer;
begin
  i := 1;
  ClrScr;
  while Head^.Next <> nil do begin
    Head := Head^.Next;
    ShowRec(Head, i);
    Inc(i);
  end;
  WriteLn;
  WriteLn('==========================================================');
  WriteLn(i, ' records shown');
  ReadLn;
end;

procedure FreeAll(var Head: PMyNode);
var
  Temp: PMyNode;
begin
  while Head^.Next <> nil do begin
    Temp := Head^.Next;
    Dispose(Head);
    Head := Temp;
  end;
  Dispose(Head);
end;

procedure CreateNewFile(Head: PMyNode);
var
  F: File of TMyNode;
begin
  Assign(F, FileName);
  ReWrite(F);
  while Head^.Next <> nil do begin
    Write(F, Head^);
    Head := Head^.Next;
  end;
  Write(F, Head^);
  Close(F);
end;

procedure ReadFile(var First, Prev, Current: PMyNode);
var
  F: File of TMyNode;
begin
  Assign(F, FileName);
  Reset(F);
  CreateNew(Current);
  Read(F, Current^);
  First := Current;
  while not Eof(F) do begin
    Prev := Current;
    CreateNew(Current);
    Read(F, Current^);
    Prev^.Next := Current;
  end;
  Close(F);
end;

procedure Main(var First, Prev, Current: PMyNode);
var
  F      : Text;
begin
  {$I-}
  Assign (f, 'HW2FILE.TXT');
  Reset(f);
  {$I+}
  if (IOResult <> 0) then begin
    WriteLn('error Reading File');
    Halt;
  end;
  CreateNew(Current);
  ReadLn(F, Current^.Name);
  ReadLn(F, Current^.Flight);
  ReadLn(F, Current^.Day);
  First := Current;
  while not Eof(F) do begin
    Prev := Current;
    CreateNew(Current);
    ReadLn(F, Current^.Name);
    ReadLn(F, Current^.Flight);
    ReadLn(F, Current^.Day);
    Prev^.Next := Current;
  end;
  Close(F);
  Show(First);
  CreateNewFile(First);
end;

function WriteMenu: Char;
var
  Ch: Char;
begin
  ClrScr;
  GotoXY(1, 1);
  WriteLn('A) Add');
  WriteLn('D) Delete');
  WriteLn('S) Show');
  WriteLn('W) Write File');
  WriteLn('X) Exit');
  repeat
    Ch := UpCase(ReadKey);
  until Ch in ['A', 'D', 'S', 'W', 'X'];
  WriteMenu := Ch;
end;

var
  Ch: Char;
  First,
  Prev,
  Current: PMyNode;

begin
  ClrScr;
  {  Main(First, Prev, Current); Use this option to read text file }
  ReadFile(First, Prev, Current);
  repeat
    Ch := WriteMenu;
    case Ch of
      'A': Add(Prev, Current);
      'D': DoDelete(First, Current);
      'S': Show(First);
      'W': CreateNewFile(First);
    end;
  until Ch = 'X';
end.
end. { main program}